home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok19 / patterns / lopattern.mod < prev    next >
Text File  |  1993-11-04  |  4KB  |  170 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.     LoPattern.mod
  3.     :Contents.      Definiert und setzt Füllmuster für 1:1-Graphik
  4.     :Contents      (Lores-normal oder Hires-interlace)
  5.     :Author.      Bernd Preusing
  6.     :Address.      Gerhardstr. 16  D-2200 Elmshorn
  7.     :Phone.      04121/22486
  8.     :Copyright.      Public Domain
  9.     :Language.      Modula-2
  10.     :Translator.  M2Amiga V3.2e
  11.     :History.      V1.0  1-May-89 Preusing
  12.     :Bugs.      none
  13. ---------------------------------------------------------------------------*)
  14. IMPLEMENTATION MODULE LoPattern;
  15.  
  16. FROM SYSTEM    IMPORT    ADR, ADDRESS, INLINE;
  17. FROM Graphics    IMPORT    RastPortPtr;
  18.  
  19. (* from .def:
  20. TYPE
  21.   Pattern =
  22.     (full, wideLD, narrowLD, wideRD, narrowRD, wideR, narrowR, wideD, narrowD,
  23.      wideCross, narrowCross, half, quart, eight, wideCheck, narrowCheck,
  24.      bigDot, smallDot, wave, crossWave, bricks);
  25. *)
  26.  
  27. (* Pattern-Daten: *)
  28. PROCEDURE WideRO;(* $E- *)
  29. BEGIN INLINE(
  30.   00101H, 00202H, 00404H, 00808H, 01010H, 02020H, 04040H, 08080H)
  31. END WideRO;
  32.  
  33. PROCEDURE NarrowRO;(* $E- *)
  34. BEGIN INLINE(
  35.   01111H, 02222H, 04444H, 08888H)
  36. END NarrowRO;
  37.  
  38. PROCEDURE WideLO;(* $E- *)
  39. BEGIN INLINE(
  40.   08080H, 04040H, 02020H, 01010H, 00808H, 00404H, 00202H, 00101H)
  41. END WideLO;
  42.  
  43. PROCEDURE NarrowLO;(* $E- *)
  44. BEGIN INLINE(
  45.   08888H, 04444H, 02222H, 01111H)
  46. END NarrowLO;
  47.  
  48. PROCEDURE Waager1;(* $E- *)
  49. BEGIN INLINE(
  50.   0FFFFH, 00000H, 00000H, 00000H)
  51. END Waager1;
  52.  
  53. PROCEDURE Waager2;(* $E- *)
  54. BEGIN INLINE(
  55.   0FFFFH, 00000H)
  56. END Waager2;
  57.  
  58. PROCEDURE Senkr1;(* $E- *)
  59. BEGIN INLINE(
  60.   08888H)
  61. END Senkr1;
  62.  
  63. PROCEDURE Senkr2;(* $E- *)
  64. BEGIN INLINE(
  65.   0AAAAH)
  66. END Senkr2;
  67.  
  68. PROCEDURE LargeCross;(* $E- *)
  69. BEGIN INLINE(
  70.   04141H, 02222H, 01414H, 00808H, 01414H, 02222H, 04141H, 08080H)
  71. END LargeCross;
  72.  
  73. PROCEDURE SmallCross;(* $E- *)
  74. BEGIN INLINE(
  75.   05555H, 02222H, 05555H, 08888H)
  76. END SmallCross;
  77.  
  78. PROCEDURE Half;(* $E- *)
  79. BEGIN INLINE(
  80.   0AAAAH, 05555H)
  81. END Half;
  82.  
  83. PROCEDURE Quart;(* $E- *)
  84. BEGIN INLINE(
  85.   08888H, 02222H, 04444H, 01111H)
  86. END Quart;
  87.  
  88. PROCEDURE Eight;(* $E- *)
  89. BEGIN INLINE(
  90.   08080H, 00808H, 02020H, 00202H, 01010H, 00101H, 04040H, 00404H)
  91. END Eight;
  92.  
  93. PROCEDURE Check;(* $E- *)
  94. BEGIN INLINE(
  95.   0F0F0H, 0F0F0H, 0F0F0H, 0F0F0H, 00F0FH, 00F0FH, 00F0FH, 00F0FH)
  96. END Check;
  97.  
  98. PROCEDURE MidCheck;(* $E- *)
  99. BEGIN INLINE(
  100.   0CCCCH, 0CCCCH, 03333H, 03333H)
  101. END MidCheck;
  102.  
  103. PROCEDURE DDot;(* $E- *)
  104. BEGIN INLINE(
  105.   00606H, 00F0FH, 00F0FH, 00606H, 06060H, 0F0F0H, 0F0F0H, 06060H)
  106. END DDot;
  107.  
  108. PROCEDURE SmallDot;(* $E- *)
  109. BEGIN INLINE(
  110.   00000H, 02020H, 07070H, 02020H, 00000H, 00202H, 00707H, 00202H)
  111. END SmallDot;
  112.  
  113. PROCEDURE Wave;(* $E- *)
  114. BEGIN INLINE(
  115.   06060H, 09090H, 00909H, 00606H)
  116. END Wave;
  117.  
  118. PROCEDURE DWave;(* $E- *)
  119. BEGIN INLINE(
  120.   00808H, 06868H, 09090H, 02929H, 04646H, 04040H, 02020H, 01010H)
  121. END DWave;
  122.  
  123. PROCEDURE Bricks;(* $E- *)
  124. BEGIN INLINE(
  125.   0FEFEH, 0FEFEH, 0FEFEH, 00000H, 0DFDFH, 0DFDFH, 0DFDFH, 00000H)
  126. END Bricks;
  127.  
  128. PROCEDURE Heights;(* $E- *)
  129. BEGIN INLINE(
  130.   0,3,2,3,2,2,1,0,0,3,2,1,2,3,3,2,3,3,2,3,3)
  131. END Heights;
  132.  
  133.  
  134. VAR Patterns: ARRAY Pattern OF ADDRESS;
  135.     HighPtr : POINTER TO ARRAY Pattern OF INTEGER;
  136.  
  137. PROCEDURE SetPattern(rp: RastPortPtr; nr:Pattern);
  138. BEGIN
  139.   WITH rp^ DO
  140.     areaPtrn:=Patterns[nr];
  141.     areaPtSz:=HighPtr^[nr];
  142.   END;
  143. END SetPattern;
  144.  
  145.  
  146. BEGIN
  147.   HighPtr:=ADR(Heights);
  148.   Patterns[full]    := NIL;
  149.   Patterns[wideLD]    :=ADR(WideRO);
  150.   Patterns[narrowLD]    :=ADR(NarrowRO);
  151.   Patterns[wideRD]    :=ADR(WideLO);
  152.   Patterns[narrowRD]    :=ADR(NarrowLO);
  153.   Patterns[wideR]    :=ADR(Waager1);
  154.   Patterns[narrowR]    :=ADR(Waager2);
  155.   Patterns[wideD]    :=ADR(Senkr1);
  156.   Patterns[narrowD]    :=ADR(Senkr2);
  157.   Patterns[wideCross]    :=ADR(LargeCross);
  158.   Patterns[narrowCross]    :=ADR(SmallCross);
  159.   Patterns[half]    :=ADR(Half);
  160.   Patterns[quart]    :=ADR(Quart);
  161.   Patterns[eight]    :=ADR(Eight);
  162.   Patterns[wideCheck]    :=ADR(Check);
  163.   Patterns[narrowCheck]    :=ADR(MidCheck);
  164.   Patterns[bigDot]    :=ADR(DDot);
  165.   Patterns[smallDot]    :=ADR(SmallDot);
  166.   Patterns[wave]    :=ADR(Wave);
  167.   Patterns[crossWave]    :=ADR(DWave);
  168.   Patterns[bricks]    :=ADR(Bricks);
  169. END LoPattern.mod
  170.